00100		DIMENSION II(1000),JJ(1000),KK(1000),LL(1000),KP(5),NN(4000)
00200		1,A(500),B(500),IB(500)
00300		COMMON KP,NP,NN,JF
00400		IMP(I)=IABS(NN(I)/100000000)
00500	1	JE=0
00600		MN=0
00700		IP=-1
00800		MO=0
00900		NZ=10
01000		IM=0
01100		JF=0
01200		IS=-1
01300		NF=1
01400		CALL DPYCLR
01500		CALL TYPLOC(-350,-511)
01600		DO 407 I=1,4
01700	407	KP(I)='     '
01800		CALL DPYSET(4,LL,1000)
01900		CALL DPYSET(3,KK,1000)
02000		CALL DPYSET(2,JJ,1000)
02100		CALL DPYSET(1,II,1000)
02200		MN=0
02300	2	TYPE 5
02400	5	FORMAT(' TYPE:<CR>;TO DRAW NEW PICTURE.'/
02500		1' OR TYPE IN NAME TO USE OLD PICTURE.'/)
02600		ACCEPT 3,NAM
02700	3	FORMAT(A5)
02800		IF(NAM.EQ.'     ')GO TO 140
02900	   	IF(.NOT.LOOKD(NAM))GO TO 2
03000	515	CALL IFILE(1,NAM)
03100		READ(1)LE,(NN(K),K=MN+1,MN+LE)
03200		MN=MN+LE
03300		IP=-1
03400		IF(MO.NE.'P')GO TO 517
03500		MO=100000000
03600		DO 518 K=MN-LE+1,MN
03700		MP=1
03800		IF(NN(K))MP=-1
03900		NN(K)=IABS(NN(K))
04000	518	NN(K)=MP*(NP*MO+(MOD(NN(K),MO)))
04100		GO TO 503
04200	517	DO 388 K=1,MN
04300		NP=MOD(IMP(K),10)
04400		CALL SETPOG(NP)
04500		CALL INXY(NX,NY,K)
04600		MP=1
04700		IF(NN(K))MP=-1
04800	388	CALL IPEN(NX,NY,MP,NZ)
04900	   	DO 193 I=1,4
05000		KP(I)='VIS  '
05100	193	CALL DPYOUT(I)
05200		CALL SETPOG(1)
05300	140	NP=1
05400		CALL IPOG(NZ)
05500	
05600	211	NS=0
05700	120	LV=0
05800	144	CALL SETCUR(NX,NY,LV)
05900		IF(NS)TYPE 6
06000	6	FORMAT(' :'$)
06100		IF(JF.GT.0)TYPE 634
06200	634	FORMAT(' O'$)
06300		ACCEPT 103,M,N
06400	103	FORMAT(2A1)
06500		LX=NX
06600		LY=NY
06700		CALL RDCUR(NX,NY)
06800		IF(NC)GO TO 191
06900		IF(M.NE.' ')GO TO 11
07000	308	IF(LV.NE.0)GO TO 192
07100	301	CALL IPAK(NX,NY,MN,1,NZ)
07200		LV=1
07300		GO TO 144
07400	192 	CALL IPAK(NX,NY,MN,-1,NZ)
07500	341	N=NP
07600	278	CALL DPYOUT(N)
07700		KP(N)='VIS  '
07800	360	IF(IP)CALL IPOG(NZ)
07900	260	IF(NS)GO TO 144
08000		GO TO 120
08100	
08200	11	IF(M.EQ.':')GO TO 261
08300		IF(M.EQ.'.')GO TO 303
08400		IF(M.EQ.'W')GO TO 380
08500	  	IF(M.EQ.'H')GO TO 306
08600		IF(M.EQ.'V')GO TO 307
08700		IF(M.EQ.'B')GO TO 105
08800	  	IF(M.EQ.'C')GO TO 150
08900		IF(M.EQ.'+')GO TO 500
09000		IF(M.EQ.'-')GO TO 501
09100		IF(M.EQ.'*')GO TO 502
09200		IF(M.EQ.'J')GO TO 608
09300		IF(M.EQ.'O')GO TO 630
09400		IF(M.EQ.'A')GO TO 510
09500		IF(M.EQ.'E')GO TO 425
09600		IF(M.EQ.'(')GO TO 431
09700		IF(M.EQ.')')GO TO 432
09800	  	IF(M.EQ.'I'.OR.M.EQ.'S')GO TO 230
09900		IF(M.EQ.'X')GO TO 104
10000		IF(M.EQ.'Z')GO TO 580
10100		IF(M.EQ.'F')GO TO 601
10200		IF(M.NE.'P')GO TO 260
10300		IP=-1
10400		IF(N.EQ.'I')GO TO 258
10500		IF(N.EQ.'D')GO TO 340
10600		IF(N.NE.' ')GO TO 231
10700	259	NP=NP+1
10800		IF(NP.GT.4)NP=1
10900	251	CALL SETPOG(NP)
11000		GO TO 503
11100	630	IF(JF.GT.0)GO TO 701
11200		REREAD 710,M,JF
11300	710	FORMAT(A1,I2)
11400		IF(JF.LT.1.OR.JF.GT.19.OR.JF.EQ.10)JF=1
11500		GO TO 261
11600	701	JF=0
11700		GO TO 211
11800	303	IF(LV.EQ.0)GO TO 301
11900		CALL IPAK(NX,NY,MN,-1,NZ)
12000	333	KP(NP)='VIS  '
12100		IF(IP)CALL IPOG(NZ)
12200		CALL DPYOUT(NP)
12300		NX=LX
12400		NY=LY
12500		IF(.NOT.NC)GO TO 301
12600		NC=0
12700		GO TO 211
12800	601	IT=0
12900	702	IT=IT+1
13000		IF(IT.GT.19)GO TO 708
13100		IF(IT.EQ.10)IT=11
13200		I=0
13300		K=0
13400	602	I=I+1
13500		IF(I.GT.MN)GO TO 660
13600	606	IF(MOD(IMP(I),10).NE.NP)GO TO 602
13700		IF(IMP(I)/10.NE.IT)GO TO 602
13800		K=K+1
13900		CALL INXY(N,M,I)
14000		IF(IT.GT.10)CALL INXY(M,N,I)
14100		A(K)=N*NZ/10
14200		B(K)=M*NZ/10
14300		IB(K)=3
14400		IF(NN(I))IB(K)=2
14500		I=I+1
14600		IF(I.LE.MN)GO TO 606
14700	660	IF(K.LT.3)GO TO 702
14800		IB(1)=K
14900		JI=IT
15000		IF(IT.GT.10)JI=IT-10
15100		IF(IS)JI=JI+5
15200		CALL FILLER(A,B,IB,JI,IS,IT)
15300		GO TO 702
15400	708	IF(IS)GO TO 341
15500		GO TO 689
15600	608	NV=-1
15700		IF(LV.EQ.0)NV=1
15800		CALL IPAK(JX,JY,MN,NV,NZ)
15900		NX=JX
16000		NY=JY
16100		GO TO 341
16200	306	NY=LY
16300		GO TO 308
16400	307	NX=LX
16500		GO TO 308
16600	230	IF(N.EQ.' ')GO TO 258
16700	231	IF(N.LT.'1'.OR.N.GT.'4')GO TO 255
16800		REREAD 408,M,N
16900	408	FORMAT(A1,I1)
17000		IF(M.EQ.'S')GO TO 278
17100	   	IF(M.NE.'I')GO TO 256
17200	257	KP(N)='     '
17300		CALL HYDPOG(N)
17400		IF(M.EQ.'P')GO TO 259
17500		GO TO 360
17600	255	IF(M.EQ.'P')GO TO 259
17700	258	IF(M.EQ.'S')GO TO 341
17800		N=NP
17900		GO TO 257
18000	256	NP=N
18100		GO TO 251
18200	261	IF(NS)GO TO 211
18300		NS=-1
18400		IF(LV.EQ.1)GO TO 666
18500		JX=NX
18600		JY=NY
18700		GO TO 301
18800	666	JX=LX
18900		JY=LY
19000		GO TO 192
19100	580	IF(IP)GO TO 581
19200		IP=-1
19300		GO TO 360
19400	581	IP=0
19500		N=5
19600		GO TO 257
19700	500	IF(NZ.EQ.20)GO TO 503
19800		NZ=NZ+1
19900		GO TO 503
20000	501	IF(NZ.EQ.5)GO TO 503
20100		NZ=NZ-1
20200		GO TO 503
20300	502	IF(NZ.EQ.10)GO TO 503
20400		NZ=10
20500	503	CALL CLRPOG(NP)
20600		CALL IDRA(MN,NZ)
20700		GO TO 335
20800	510	REREAD 516,MO,NAM
20900	516	FORMAT(1XA1,A5)
21000		IF(.NOT.LOOKD(NAM))GO TO 260
21100		GO TO 515
21200	340	CALL CLRPOG(NP)
21300		J=0
21400	400	J=J+1
21500	507	IF(J.GT.MN)GO TO 466
21600		MP=MOD(IMP(J),10)
21700		IF(MP.NE.NP)GO TO 400
21800		DO 401 I=J,MN-1
21900	401	NN(I)=NN(I+1)
22000		MN=MN-1
22100		GO TO 507
22200	466	IF(JE)GO TO 467
22300		IP=-1
22400		GO TO 431
22500	105	LP=MOD(IMP(MN),10)
22600		IF(MN.LT.1.OR.LP.NE.NP)GO TO 335
22700		IF(NP.EQ.1)II(2)=II(2)-1
22800		IF(NP.EQ.2)JJ(2)=JJ(2)-1
22900		IF(NP.EQ.3)KK(2)=KK(2)-1
23000		IF(NP.EQ.4)LL(2)=LL(2)-1
23100	        CALL ACCPOG(NP)
23200		MN=MN-1
23300	335	NS=0
23400		GO TO 341
23500	150	NC=-1
23600		IF(LV.NE.1)GO TO 301
23700	191	R=0
23800		MN=MN-1
23900		RM=(NX-LX)**2+(NY-LY)**2
24000		RM=SQRT(RM)
24100		KX=LX+RM*SIND(R)
24200		KY=LY+RM*COSD(R)
24300		CALL IPAK(KX,KY,MN,1,NZ)
24400		DO 151 K=6,360,6
24500		R=K
24600		KX=LX+RM*SIND(R)
24700		KY=LY+RM*COSD(R)
24800	151	CALL IPAK(KX,KY,MN,-1,NZ)
24900		GO TO 333
25000	380	IF(LV.NE.1)GO TO 103
25100		REREAD 377,M,N
25200	377	FORMAT(A1,I2)
25300		IF(N.LT.4)N=100
25400		KN=N/10
25500		IF(KN.LT.2)KN=2
25600		DO 381 I=0,N,KN
25700		CALL IPAK(LX-N/2+I,LY-N/2+I,MN,1,NZ)
25800	381	CALL IPAK(NX-N/2+I,NY-N/2+I,MN,-1,NZ)
25900		GO TO 341
26000	425	I=0
26100	426	I=I+1
26200		IF(I.GT.MN)GO TO 211
26300	430	IF(MOD(IMP(I),10).NE.NP)GO TO 426
26400	548	CALL INXY(NX,NY,I)
26500		CALL SETCUR(NX*NZ/10,NY*NZ/10,1)
26600		TYPE 469
26700	469	FORMAT(' ERASE?'$)
26800		ACCEPT 103,M,N
26900		IF(M.EQ.' ')GO TO 426
27000		IF(M.EQ.'Y')GO TO 470
27100		IF(M.EQ.'I')GO TO 547
27200		IF(M.NE.'B')GO TO 211
27300	549	I=I-1
27400		IF(I.LT.1)GO TO 211
27500		IF(MOD(IMP(I),10).NE.NP)GO TO 549
27600		GO TO 548
27700	547	NN(I)=IABS(NN(I))
27800		GO TO 471
27900	470	MN=MN-1
28000		DO 428 K=I,MN
28100	428	NN(K)=NN(K+1)
28200	471	CALL CLRPOG(NP)
28300		CALL IDRA(MN,NZ)
28400		CALL DPYOUT(NP)
28500		GO TO 430
28600	431	NX=0
28700		NY=0
28800		NF=MN+1
28900		IM=0
29000		GO TO 211
29100	432	IF(IM.EQ.0)IM=MN
29200		DO 433 I=NF,IM
29300		CALL INXY(IX,IY,I)
29400		IX=NX+IX
29500		IY=NY+IY
29600		MP=1
29700		IF(NN(I))MP=-1
29800	433	CALL IPAK(IX,IY,MN,MP,NZ)
29900		GO TO 341
30000	
30100	104	CALL CLRCUR
30200		CALL IPOG(NZ)
30300		IP=-1
30400	   	TYPE 111
30500	111	FORMAT(' TYPE:<CR>;TO CONTINUE.'/' TYPE:''N''<CR>;TO START OVER.'/
30600		2' TYPE:''X'' TO SAVE VIS POGS IF FINISHED'/
30700		3' OR TYPE:''P'' TO PLOT ALL VIS POGS'/)
30800		ACCEPT 103,M,NV
30900		IF(M.EQ.'N')GO TO 1
31000		IF(M.EQ.'P')GO TO 557
31100		IF(M.NE.'X')GO TO 120
31200	127	TYPE 121
31300	121	FORMAT(' TYPE A FIVE LETTER NAME FOR THIS PICTURE.'/)
31400		ACCEPT 3,NAM
31500		IF(NAM.EQ.'     ')GO TO 127
31600	557	MP=0
31700		DO 405 IK=1,4
31800		IF(KP(IK).NE.'VIS  ')GO TO 405
31900		MP=MP+1
32000	405	CONTINUE
32100		IF(MP.EQ.0)GO TO 104
32200		IF(M.EQ.'P')GO TO 555
32300		NP=0
32400		JE=-1
32500	467	NP=NP+1
32600		IF(NP.GT.4)GO TO 468
32700		IF(KP(NP).NE.'VIS  ')GO TO 340
32800		GO TO 467
32900	468	CALL OFILE(1,NAM)
33000		WRITE(1)MN,(NN(K),K=1,MN)
33100		END FILE 1
33200		GO TO 1
33300	555	TYPE 587
33400	587	FORMAT(/' PLOTING CURRENT POG'/)
33500		CALL PLOTS(I)
33600		IS=0
33700		GO TO 601
33800	689	IF(NV.EQ.'L')GO TO 711
33900		DO 556 I=1,MN
34000		IF(MOD(IMP(I),10).NE.NP)GO TO 556
34100		CALL INXY(NX,NY,I)
34200		MO=3
34300		IF(NN(I))MO=2
34400		CALL PLOT(NX*NZ/10,NY*NZ/10,MO)
34500	556	CONTINUE
34600	711	CALL PLOT(0,0,3)
34700		TYPE 691
34800	691	FORMAT(' FINISHED PLOTING!'/)
34900		IS=-1
35000		GO TO 211
35100		END
35200	
35300		SUBROUTINE IPOG(NZ)
35400		COMMON KP(5),NP,NN(4000),JF
35500		DIMENSION MM(30),JP(4)
35600		CALL DPYSET(5,MM,30)
35700		CALL DPYTXT(100,-430,'POG1 POG2 POG3 POG4 ZOOM ',5)
35800		KP(5)=' REG '
35900		IF(NZ.LT.10)KP(5)=' --- '
36000		IF(NZ.GT.10)KP(5)=' +++ '
36100		CALL DPYTXT(100,-450,KP,5)
36200		DO 4 J=1,4
36300		JP(J)='     '
36400	4	IF(J.EQ.NP)JP(J)=' ↑↑  '
36500		CALL DPYTXT(100,-470,JP,4)
36600		CALL DPYOUT(5)
36700		CALL SETPOG(NP)
36800		RETURN
36900		END
37000		SUBROUTINE IPAK(NX,NY,MN,MP,NZ)
37100		COMMON KP(5),NP,NN(4000),JF
37200		MN=MN+1
37300		IX=(NX*10/NZ)+1024
37400		IY=(NY*10/NZ)+1024
37500		NN(MN)=MP*((JF*10+NP)*100000000+IX*10000+IY)
37600		CALL IPEN(NX,NY,MP,10)
37700		RETURN
37800		END
37900		SUBROUTINE IPEN(NX,NY,MP,NZ)
38000		IX=NX*NZ/10
38100		IF(IX.GT.950)IX=950
38200		IF(IX.LT.-950)IX=-950
38300		IY=NY*NZ/10
38400		IF(IY.GT.950)IY=950
38500		IF(IY.LT.-950)IY=-950
38600		IF(MP)GO TO 1
38700		CALL AIVECT(IX,IY)
38800		RETURN
38900	1	CALL AVECT(IX,IY)
39000		RETURN
39100		END
39200		SUBROUTINE INXY(NX,NY,MN)
39300		COMMON KP(5),NP,NN(4000),JF
39400		J=IABS(NN(MN))
39500		NY=MOD(J,10000)-1024
39600		NX=(MOD(J,100000000)/10000)-1024
39700		RETURN
39800		END
39900		SUBROUTINE IDRA(MN,NZ)
40000		COMMON KP(5),NP,NN(4000),JF
40100		DO 1 I=1,MN
40200		KF=MOD(IABS(NN(I)/100000000),10)
40300		IF(KF.NE.NP)GO TO 1
40400		CALL INXY(IX,IY,I)
40500		CALL IPEN(IX,IY,NN(I),NZ)
40600	1	CONTINUE
40700		RETURN
40800		END